home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / lzh_pas.exe / LZH.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-23  |  20KB  |  852 lines
  1. unit lzh;
  2. {$A+,B-,D+,E-,F-,I+,L+,N-,O+,R-,S-,V-}
  3. (*
  4.  * LZHUF.C English version 1.0
  5.  * Based on Japanese version 29-NOV-1988
  6.  * LZSS coded by Haruhiko OKUMURA
  7.  * Adaptive Huffman Coding coded by Haruyasu YOSHIZAKI
  8.  * Edited and translated to English by Kenji RIKITAKE
  9.  * Translated from C to Turbo Pascal by Douglas Webb   2/18/91
  10.  *)
  11.  
  12. {
  13.      This unit allows the user to commpress data using a combination of
  14.    LZSS compression and adaptive Huffman coding, or conversely to decompress
  15.    data that was previously compressed by this unit.
  16.  
  17.      There are a number of options as to where the data being compressed/
  18.    decompressed is coming from/going to.
  19.  
  20.     In fact it requires that you pass the "LZHPack" procedure 2 procedural
  21.   parameter of type 'GetProcType' and 'PutProcType' (declared below) which
  22.   will accept 3 parameters and act in every way like a 'BlockRead'/'BlockWrite'
  23.   procedure call. Your 'GetProcType' procedure should return the data
  24.   to be compressed, and Your 'PutProcType' procedure should do something with
  25.   the compressed data (ie., put it in a file).  In case you need to know (and
  26.   you do if you want to decompress this data again) the number of bytes in the
  27.   compressed data (original, not compressed size) is returned in 'Bytes_Written'.
  28.  
  29.   GetBytesProc = PROCEDURE(VAR DTA; NBytes:WORD; VAR Bytes_Got : WORD);
  30.   
  31.   DTA is the start of a memory location where the information returned should
  32.   be.  NBytes is the number of bytes requested.  The actual number of bytes
  33.   returned must be passed in Bytes_Got (if there is no more data then 0
  34.   should be returned).
  35.  
  36.   PutBytesProc = PROCEDURE(VAR DTA; NBytes:WORD; VAR Bytes_Got : WORD);
  37.  
  38.   As above except instead of asking for data the procedure is dumping out
  39.   compressed data, do somthing with it.
  40.  
  41.  
  42.     "LZHUnPack" is basically the same thing in reverse.  It requires
  43.   procedural parameters of type 'PutProcType'/'GetProcType' which
  44.   will act as above.  'GetProcType' must retrieve data compressed using
  45.   "LZHPack" (above) and feed it to the unpacking routine as requested.
  46.   'PutProcType' must accept the decompressed data and do something
  47.   withit.  You must also pass in the original size of the decompressed data,
  48.   failure to do so will have adverse results.
  49.  
  50.  
  51.      Don't forget that as procedural parameters the 'GetProcType'/'PutProcType'
  52.   procedures must be compiled in the 'F+' state to avoid a catastrophe.
  53.  
  54.  
  55.  
  56. }
  57.  
  58. { Note: All the large data structures for these routines are allocated when
  59.   needed from the heap, and deallocated when finished.  So when not in use
  60.   memory requirements are minimal.  However, this unit uses about 34K of
  61.   heap space, and 400 bytes of stack when in use. }
  62.  
  63.  
  64. interface
  65.  
  66. TYPE
  67.  
  68.  
  69.   PutBytesProc = PROCEDURE(VAR DTA; NBytes:WORD; VAR Bytes_Put : WORD);
  70.   GetBytesProc = PROCEDURE(VAR DTA; NBytes:WORD; VAR Bytes_Got : WORD);
  71.  
  72.  
  73.  
  74. Procedure LZHPack(VAR Bytes_Written:LongInt; GetBytes:GetBytesProc; PutBytes:PutBytesProc);
  75. Procedure LZHUnpack(TextSize : Longint; GetBytes:GetBytesProc; PutBytes: PutBytesProc);
  76.  
  77.  
  78.  
  79.  
  80. implementation
  81.  
  82. CONST
  83.   EXIT_OK = 0;
  84.   EXIT_FAILED = 1;
  85. { LZSS Parameters }
  86.   N        = 4096;    { Size of string buffer }
  87.   F        = 60;    { Size of look-ahead buffer }
  88.   THRESHOLD    = 2;
  89.   NUL        = N;    { End of tree's node  }
  90.   N_CHAR   =    (256 - THRESHOLD + F);
  91.         { character code (:= 0..N_CHAR-1) }
  92.   T        =    (N_CHAR * 2 - 1);    { Size of table }
  93.   R        =    (T - 1);        { root position }
  94.   MAX_FREQ =    $8000;
  95.                     { update when cumulative frequency }
  96.                     { reaches to this value }
  97. {
  98.  * Tables FOR encoding/decoding upper 6 bits of
  99.  * sliding dictionary pointer
  100.  }
  101. { encoder table }
  102.   p_len : Array[0..63] of BYTE =
  103.        ($03, $04, $04, $04, $05, $05, $05, $05,
  104.     $05, $05, $05, $05, $06, $06, $06, $06,
  105.     $06, $06, $06, $06, $06, $06, $06, $06,
  106.     $07, $07, $07, $07, $07, $07, $07, $07,
  107.     $07, $07, $07, $07, $07, $07, $07, $07,
  108.     $07, $07, $07, $07, $07, $07, $07, $07,
  109.     $08, $08, $08, $08, $08, $08, $08, $08,
  110.     $08, $08, $08, $08, $08, $08, $08, $08);
  111.  
  112.   p_code : Array [0..63] OF BYTE =
  113.        ($00, $20, $30, $40, $50, $58, $60, $68,
  114.     $70, $78, $80, $88, $90, $94, $98, $9C,
  115.     $A0, $A4, $A8, $AC, $B0, $B4, $B8, $BC,
  116.     $C0, $C2, $C4, $C6, $C8, $CA, $CC, $CE,
  117.     $D0, $D2, $D4, $D6, $D8, $DA, $DC, $DE,
  118.     $E0, $E2, $E4, $E6, $E8, $EA, $EC, $EE,
  119.     $F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,
  120.     $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF);
  121.  
  122. { decoder table }
  123.   d_code: Array [0..255] OF BYTE =
  124.        ($00, $00, $00, $00, $00, $00, $00, $00,
  125.     $00, $00, $00, $00, $00, $00, $00, $00,
  126.     $00, $00, $00, $00, $00, $00, $00, $00,
  127.     $00, $00, $00, $00, $00, $00, $00, $00,
  128.     $01, $01, $01, $01, $01, $01, $01, $01,
  129.     $01, $01, $01, $01, $01, $01, $01, $01,
  130.     $02, $02, $02, $02, $02, $02, $02, $02,
  131.     $02, $02, $02, $02, $02, $02, $02, $02,
  132.     $03, $03, $03, $03, $03, $03, $03, $03,
  133.     $03, $03, $03, $03, $03, $03, $03, $03,
  134.     $04, $04, $04, $04, $04, $04, $04, $04,
  135.     $05, $05, $05, $05, $05, $05, $05, $05,
  136.     $06, $06, $06, $06, $06, $06, $06, $06,
  137.     $07, $07, $07, $07, $07, $07, $07, $07,
  138.     $08, $08, $08, $08, $08, $08, $08, $08,
  139.     $09, $09, $09, $09, $09, $09, $09, $09,
  140.     $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,
  141.     $0B, $0B, $0B, $0B, $0B, $0B, $0B, $0B,
  142.     $0C, $0C, $0C, $0C, $0D, $0D, $0D, $0D,
  143.     $0E, $0E, $0E, $0E, $0F, $0F, $0F, $0F,
  144.     $10, $10, $10, $10, $11, $11, $11, $11,
  145.     $12, $12, $12, $12, $13, $13, $13, $13,
  146.     $14, $14, $14, $14, $15, $15, $15, $15,
  147.     $16, $16, $16, $16, $17, $17, $17, $17,
  148.     $18, $18, $19, $19, $1A, $1A, $1B, $1B,
  149.     $1C, $1C, $1D, $1D, $1E, $1E, $1F, $1F,
  150.     $20, $20, $21, $21, $22, $22, $23, $23,
  151.     $24, $24, $25, $25, $26, $26, $27, $27,
  152.     $28, $28, $29, $29, $2A, $2A, $2B, $2B,
  153.     $2C, $2C, $2D, $2D, $2E, $2E, $2F, $2F,
  154.     $30, $31, $32, $33, $34, $35, $36, $37,
  155.     $38, $39, $3A, $3B, $3C, $3D, $3E, $3F);
  156.  
  157.  d_len: Array[0..255] of BYTE =
  158.        ($03, $03, $03, $03, $03, $03, $03, $03,
  159.     $03, $03, $03, $03, $03, $03, $03, $03,
  160.     $03, $03, $03, $03, $03, $03, $03, $03,
  161.     $03, $03, $03, $03, $03, $03, $03, $03,
  162.     $04, $04, $04, $04, $04, $04, $04, $04,
  163.     $04, $04, $04, $04, $04, $04, $04, $04,
  164.     $04, $04, $04, $04, $04, $04, $04, $04,
  165.     $04, $04, $04, $04, $04, $04, $04, $04,
  166.     $04, $04, $04, $04, $04, $04, $04, $04,
  167.     $04, $04, $04, $04, $04, $04, $04, $04,
  168.     $05, $05, $05, $05, $05, $05, $05, $05,
  169.     $05, $05, $05, $05, $05, $05, $05, $05,
  170.     $05, $05, $05, $05, $05, $05, $05, $05,
  171.     $05, $05, $05, $05, $05, $05, $05, $05,
  172.     $05, $05, $05, $05, $05, $05, $05, $05,
  173.     $05, $05, $05, $05, $05, $05, $05, $05,
  174.     $05, $05, $05, $05, $05, $05, $05, $05,
  175.     $05, $05, $05, $05, $05, $05, $05, $05,
  176.     $06, $06, $06, $06, $06, $06, $06, $06,
  177.     $06, $06, $06, $06, $06, $06, $06, $06,
  178.     $06, $06, $06, $06, $06, $06, $06, $06,
  179.     $06, $06, $06, $06, $06, $06, $06, $06,
  180.     $06, $06, $06, $06, $06, $06, $06, $06,
  181.     $06, $06, $06, $06, $06, $06, $06, $06,
  182.     $07, $07, $07, $07, $07, $07, $07, $07,
  183.     $07, $07, $07, $07, $07, $07, $07, $07,
  184.     $07, $07, $07, $07, $07, $07, $07, $07,
  185.     $07, $07, $07, $07, $07, $07, $07, $07,
  186.     $07, $07, $07, $07, $07, $07, $07, $07,
  187.     $07, $07, $07, $07, $07, $07, $07, $07,
  188.     $08, $08, $08, $08, $08, $08, $08, $08,
  189.     $08, $08, $08, $08, $08, $08, $08, $08);
  190.  
  191.   getbuf : WORD = 0;
  192.   getlen : BYTE = 0;
  193.   putlen : BYTE = 0;
  194.   putbuf : WORD = 0;
  195.   textsize : longint = 0;
  196.   codesize : longINT = 0;
  197.   printcount : longint = 0;
  198.   match_position : Integer = 0;
  199.   match_length : Integer = 0;
  200.  
  201.  
  202. TYPE
  203.   Freqtype = Array[0..T] OF WORD;
  204.   FreqPtr = ^freqtype;
  205.   PntrType = Array[0..T+N_Char] OF Integer;
  206.   pntrPtr = ^pntrType;
  207.   SonType = Array[0..T] OF Integer;
  208.   SonPtr = ^SonType;
  209.  
  210.  
  211.   TextBufType = Array[0..N+F-1] OF BYTE;
  212.   TBufPtr = ^TextBufType;
  213.   WordRay = Array[0..N+1] OF Integer;
  214.   WordRayPtr = ^WordRay;
  215.   BWordRay = Array[0..N+257] OF Integer;
  216.   BWordRayPtr = ^BWordRay;
  217.  
  218. VAR
  219.   text_buf : TBufPtr;
  220.   lson,dad : WordRayPtr;
  221.   rson : BWordRayPtr;
  222.   freq : FreqPtr;    { cumulative freq table }
  223.  
  224. {
  225.  * pointing parent nodes.
  226.  * area [T..(T + N_CHAR - 1)] are pointers FOR leaves
  227.  }
  228.   prnt : PntrPtr;
  229.  
  230. { pointing children nodes (son[], son[] + 1)}
  231.   son